1 IFPEEK(56)<>143THENPOKE56,143:POKE52,143:CLR:LOAD"HARDCOPY",8,1 2 : 10 REM ************************ 12 REM * KLIMA 64 VERSION 2.0 * 14 REM * MATTHIAS KRIESELL * 16 REM * OSTPREUSSENSTRASSE 6 * 18 REM * 3057 NEUSTADT A.R. * 20 REM * TEL.: 05032/5880 * 22 REM ************************ 24 : 100 REM *** M-ROUTINEN **************** 102 IN=49152:CL=49397:AN=49460 104 AU=49479:PR=50688:PL=50746 106 LI=50761:CH=49254:FO=2159 108 : 200 REM *** INITIALISIEREN ************ 202 SYS49152:REM PR.I/O AKTIVIEREN 204 C1$=CHR$(13):C2$=CHR$(20) 206 OP$="DATEN,L,"+CHR$(38) 208 QW=255:DIMQQ$(QW) 210 DIMT(12),N(12),R(12),MO$(12) 212 FORI=1TO12:READMO$(I):NEXT 214 Z$=CHR$(0) 216 H4$="[197]RFA\TE [207]RTE AUSGEBEN" 218 XL=174:XH=175:YA=176:Z=130 220 BW$="[194]ITTE W@HLEN [211]IE:" 222 C$(0)=" " 224 C$(1)=" " 226 POKE650,128 900 REM *** ERSTE INDIZIERUNG ********* 902 OPEN1,8,15:SV=0:GOSUB7020 904 : 1000 REM *** HAUPTMENU **************** 1002 GOSUB7000 1004 SYSPR,132,4,"[200]AUPTMENU" 1006 SYSPR,115,7,BW$ 1008 SYSPR,101,9,"1) [203]LIMAWERTE EINGEBEN" 1010 SYSPR,100,11,"2) [203]LIMADIAGRAMM ERSTELLEN" 1012 SYSPR,100,13,"3) [200]ILFSPROGRAMME" 1014 SYSPR,100,15,"4) [208]ROGRAMM BEENDEN" 1016 A=17:W$="4":GOSUB8050 1018 ONAGOTO2000,3000,1200,1100 1020 : 1100 REM *** PROGRAMM BEENDEN ********* 1102 GOSUB7000 1104 SYSPR,112,4,"[208]ROGRAMM BEENDEN" 1106 A=7:GOSUB8070:IFNOTATHEN1000 1108 GOSUB7060 1110 CLOSE1:POKE53281,0:PRINT"[144][147]":SYSAU:SYS64738 1112 : 1200 REM *** HILFSPROGRAMME *********** 1202 GOSUB7000 1204 SYSPR,118,4,"[200]ILFSPROGRAMME" 1206 SYSPR,115,7,BW$ 1208 SYSPR,101,9,"1) [203]LIMAWERTE AUSGEBEN" 1210 SYSPR,100,11,"2) [203]LIMAWERTE @NDERN" 1212 SYSPR,100,13,"3) "+H4$ 1214 SYSPR,100,15,"4) [196]ATEI AKTUALISIEREN" 1216 SYSPR,100,17,"5) [193]NDERE [196]ATENDISKETTE INDIZIEREN" 1218 SYSPR,100,19,"6) [206]EUE [196]ATEI ANLEGEN" 1220 SYSPR,100,21,"7) [218]UR^CK ZUM [200]AUPTMENU" 1222 W$="7":A=23:GOSUB8050 1224 ONAGOTO1300,1350,1400,1250,1270,1500,1000 1226 : 1250 REM *** DATEI AKTUALISIEREN ****** 1252 GOSUB7000 1254 SYSPR,108,4,"[196]ATEI AKTUALISIEREN" 1256 GOSUB7080 1258 GOTO1200 1260 : 1270 REM *** ANDERE DISKETTE ********** 1272 GOSUB7000 1274 SYSPR,92,4,"[193]NDERE [196]ISKETTE INDIZIEREN" 1276 GOSUB7060 1278 GOSUB7020 1280 GOTO1200 1282 : 1300 REM *** AUSGABE ****************** 1302 GOSUB7000 1304 SYSPR,105,4,"[203]LIMAWERTE AUSGEBEN" 1306 GOSUB7130:IFD=0THEN1200 1308 GOSUB2100 1310 GOSUB8080:GOTO1200 1312 : 1350 REM *** AENDERN ****************** 1352 GOSUB7000 1354 SYSPR,110,4,"[203]LIMAWERTE @NDERN" 1356 GOSUB7130:IFD=0THEN1200 1358 GOSUB2100:GOSUB2200 1360 GOSUB2400:GOTO1200 1362 : 1400 REM *** ORTE AUSGEBEN ************ 1402 I=0 1404 GOSUB7000 1406 SYSPR,101,4,"[197]RFA\TE [207]RTE AUSGEBEN" 1408 IFQQ=0THENSYSPR,0,7,"[203]EINE [207]RTE ERFA\T.":GOSUB8000:GOTO1200 1410 I=I+1:SYSPR,0,6+I-INT((I-1)/10)*10,QQ$(I):IFI=QQTHEN1420 1412 IFINT(I/10)<>I/10THEN1410 1414 I=I+1:SYSPR,160,6+I-INT((I-1)/10)*10,QQ$(I):IFI=QQTHEN1420 1416 IFINT(I/10)<>I/10THEN1414 1418 POKEYA,20:GOSUB8080:GOTO1404 1420 POKEYA,20:GOSUB8080:GOTO1200 1422 : 1500 REM *** DATEI ANLEGEN ************ 1501 GOSUB7000 1502 SYSPR,110,4,"[206]EUE [196]ATEI ANLEGEN" 1503 GOSUB7060 1504 GOSUB7000 1505 SYSPR,110,4,"[206]EUE [196]ATEI ANLEGEN" 1506 SYSPR,0,7,"[194]ITTE LEGEN [211]IE EINE FORMATIERTE [196]ISKETTE IN" 1508 SYSPR,0,9,"[204]AUFWERK #0. [196]IESE [196]ISKETTE WIRD EINE K^NFTIGE" 1510 SYSPR,0,11,"[196]ATENDISKETTE." 1512 SYSPR,0,13,"[198]ERTIG" 1514 GOSUB8030:IFNOTATHEN1200 1516 PRINT#1,"I":GOSUB8010:IFA<>0THENCLR:RUN 1518 PRINT#1,"M-R"+CHR$(250)+CHR$(2)+CHR$(3):GET#1,A$,B$,B$ 1520 A=ASC(A$+Z$)+256*ASC(B$+Z$) 1522 IFA>200THEN1534 1524 SYSPR,0,16,"[193]UF DER EINGELEGTEN [196]ISKETTE IST NICHT" 1526 SYSPR,0,18,"MEHR GEN^GEND [211]PEICHERRAUM VORHANDEN." 1528 SYSPR,0,20,"[193]NDERE [196]ISKETTE PROBIEREN" 1530 GOSUB8030:IFNOTATHENCLR:RUN 1532 GOTO1500 1534 OPEN2,8,2,OP$ 1536 PRINT#1,"P"+CHR$(2)+CHR$(QW)+Z$+Z$ 1538 INPUT#1,A,A$,A1,A2:IFA<>0THEN1546 1540 SYSPR,0,16,"[193]UF DER EINGELEGTEN [196]ISKETTE BEFINDET SICH" 1542 SYSPR,0,18,"BEREITS EINE '[203]LIMA 64'-[196]ATEI." 1544 GOTO1528 1546 SYSPR,0,16,"[194]ITTE WARTEN..." 1548 PRINT#2,CHR$(255) 1550 CLOSE2:INPUT#1,A,A$,A1,A2:CLR:RUN 1552 : 2000 REM *** WERTE EINGEBEN *********** 2002 GOSUB7000 2004 SYSPR,110,4,"[203]LIMAWERTE EINGEB[138]N" 2006 OT$="" 2008 FORI=1TO12:T(I)=0:N(I)=0:NEXT 2010 GOSUB2100:GOSUB2200 2012 GOSUB7000 2014 SYSPR,110,4,"[203]LIMAWERTE EINGEBEN" 2016 SYSPR,0,7,OT$+" ERFASSEN" 2018 GOSUB8030:IFNOTATHEN1000 2020 QQ=QQ+1:D=QQ:GOSUB2400:GOTO1000 2022 : 2100 REM *** FORMULAR ***************** 2102 SYSPR,0,7,"[207]RT:"+OT$ 2104 SYSPR,2,9,"[205]ONAT [212]EMP.":SYSPR,113,9,"[206][196]." 2106 SYSLI,0,69,155,69 2108 SYSLI,0,81,155,81 2110 SYSLI,0,189,155,189 2112 SYSLI,0,69,0,189 2114 SYSLI,67,69,67,189 2116 SYSLI,111,69,111,189 2118 SYSLI,155,69,155,189 2120 FORI=1TO12 2122 SYSPR,2,10+I,MO$(I) 2124 SYSPR,69,10+I,MID$(STR$(T(I)),2) 2126 SYSPR,113,10+I,MID$(STR$(N(I)),2) 2128 NEXT 2130 RETURN 2132 : 2200 REM *** EINGABE/AENDERN ********** 2202 W$=OT$:W=20:X=20:Y=7:GOSUB7100:OT$=X$ 2204 FORI=1TO12 2206 W$=MID$(STR$(T(I)),2):W=3:X=69:Y=10+I:GOSUB7100:T(I)=VAL(X$) 2208 NEXT 2210 FORI=1TO12 2212 W$=MID$(STR$(N(I)),2):W=3:X=113:Y=10+I:GOSUB7100:N(I)=VAL(X$) 2214 NEXT 2216 SYSPR,2,24,"[211]IND ALLE [193]NGABEN KORREKT" 2218 GOSUB8030:IFNOTATHEN2202 2220 RETURN 2222 : 2400 REM *** ORT ABSPEICHERN ********** 2402 QQ$(D)=OT$:SV=0 2404 OPEN2,8,2,OP$ 2406 A$="":FORI=1TO12 2408 A$=A$+CHR$(50+T(I))+CHR$(N(I)AND255)+CHR$(N(I)/256) 2410 NEXT 2412 PRINT#1,"P"+CHR$(2)+CHR$(D)+Z$+Z$ 2414 PRINT#2,A$ 2416 CLOSE2 2418 RETURN 2420 : 3000 REM *** DIAGRAMM ***************** 3002 GOSUB7000 3004 SYSPR,92,4,"[203]LIMADIAGRAMM ERSTELLEN" 3006 GOSUB7130:IFD=0THEN1000 3007 SYSFO 3008 SYSPR,0,0,OT$+", [203]LIMA" 3014 FORI=1TO12:R(I)=N(I):IFN(I)>100THENR(I)=100+((N(I)-100)/10) 3016 NEXT 3018 T(0)=(T(1)+T(12))/2 3020 R(0)=(R(1)+R(12))/2 3022 SYSLI,13,Z-T(0)*2,18,Z-T(1)*2 3024 SYSLI,13,Z-R(0),18,Z-R(1) 3026 FORI=2TO12 3028 SYSLI,8+(I-1)*10,Z-T(I-1)*2,8+I*10,Z-T(I)*2 3030 SYSLI,8+(I-1)*10,Z-R(I-1),8+I*10,Z-R(I) 3032 NEXT 3034 SYSLI,128,Z-T(12)*2,133,Z-T(0)*2 3036 SYSLI,128,Z-R(12),133,Z-R(0) 3038 FORI=1TO12 3040 IFR(I)>T(I)*2THENSYSLI,8+I*10,Z-R(I),8+I*10,Z-T(I)*2:GOTO3046 3042 IFINT(R(I)/5)=INT(T(I)*2/5)THEN3046 3044 FORJ=INT(R(I)/5+.5)*5+2.5TO(T(I)*2)-2.5STEP5:SYSPL,8+I*10,Z-J:NEXT 3046 NEXT 3048 FORI=2TO12:R=(R(I-1)+R(I))/2:T=T(I-1)+T(I) 3050 IFR>TTHENSYSLI,3+I*10,Z-R,3+I*10,Z-T:GOTO3056 3052 IFINT(R/5)=INT(T/5)THEN3056 3054 FORJ=INT(R/5+.5)*5+2.5TOT-2.5STEP5:SYSPL,3+I*10,Z-J:NEXT 3056 NEXT 3058 FORI=1TO11 3060 DR=(R(I+1)-R(I))/10 3062 FORJ=0TO9:A=8+I*10+J 3064 IF(J*DR)+R(I)>100THENSYSLI,A,30,A,130-(INT(J*DR+.5)+R(I)) 3066 NEXT:NEXT 3068 DR=(R(1)-R(0))/10 3070 FORJ=5TO9:A=8+J 3072 IF(J*DR)+R(0)>100THENSYSLI,A,30,A,130-(INT(J*DR+.5)+R(0)) 3074 NEXT 3076 DR=(R(0)-R(12))/10 3078 FORJ=0TO5:A=128+J 3080 IF(J*DR)+R(12)>100THENSYSLI,A,30,A,130-(INT(J*DR+.5)+R(12)) 3082 NEXT 3084 : 3200 A=0:TL=50:TH=-50:NL=9999:NH=0 3202 S1=0:S2=0:FORI=1TO12 3204 IFN(I)>2*T(I)THENA=A+1 3206 IFT(I)THTHENTH=T(I):T2=I 3210 IFN(I)NHTHENNH=N(I):N2=I 3214 S1=S1+T(I):S2=S2+N(I) 3216 NEXT:A=INT(A*100/12) 3217 IFTL<0THENSYSLI,13,Z,13,Z-TL*2:FORI=ZTOZ-TL*2STEP10:SYSPL,12,I:NEXT 3218 SYSPR,170,3,"[211]TATISTIK" 3220 SYSPR,170,5,"[200]UMIDES [203]LIMA:"+STR$(A)+" %" 3222 SYSPR,170,6,"[193]RRIDES [203]LIMA:"+STR$(100-A)+" %" 3224 SYSPR,170,7,"[212]EMPERATUREN:" 3226 SYSPR,170,8,"[205]IN.:"+STR$(TL)+" ("+MO$(T1)+")" 3228 SYSPR,170,9,"[205]AX.:"+STR$(TH)+" ("+MO$(T2)+")" 3230 SYSPR,170,10,"[196]URCHSCHNITT:"+STR$(INT(S1/12)) 3232 SYSPR,170,11,"[206]IEDERSCHLAG:" 3234 SYSPR,170,12,"[205]IN.:"+STR$(NL)+" MM ("+MO$(N1)+")" 3236 SYSPR,170,13,"[205]AX.:"+STR$(NH)+" MM ("+MO$(N2)+")" 3238 SYSPR,170,14,"[196]URCHSCHNITT:"+STR$(INT(S2/12))+" MM" 3240 SYSPR,170,15,"[199]ESAMT:"+STR$(S2)+" MM" 3242 POKEYA,22:GOSUB8080 3244 GOTO1000 3246 : 7000 REM *** TITEL ******************** 7002 SYSCL 7004 SYSLI,100,8,220,8 7006 SYSPR,112,0,"[203]LIMADIAGRAMM 64" 7008 SYSPR,64,2," [215]RITTEN 1986 BY [205]ATTHIAS [203]RIESELL" 7010 RETURN 7012 : 7020 REM *** INDIZIEREN *************** 7022 GOSUB7000 7024 SYSPR,107,4,"[196]ISKETTE INDIZIEREN" 7026 SYSPR,0,7,"[194]ITTE LEGEN [211]IE EINE [196]ATEINDISKETTE IN [204]AUFWERK #0." 7028 A=9:GOSUB8000 7030 PRINT#1,"I" 7032 GOSUB8010:IFATHENRETURN 7034 OPEN2,8,2,"INDEX,P,R" 7036 INPUT#2,QQ:IFQQ>0THEN7050 7038 INPUT#1,A,A$,A1,A2:CLOSE2 7040 SYSPR,0,12,"[193]CHTUNG ! [197]S SIND NOCH KEINE [203]LIMAWERTE AUF DER" 7042 SYSPR,0,14,"EINGELEGTEN [196]ISKETTE ABGESPEICHERT." 7044 SYSPR,0,16,"[215]OLLEN [211]IE EINE ANDERE [196]ISKETTE INDIZIEREN" 7046 GOSUB8030:IFATHEN7020 7048 RETURN 7050 SYSPR,0,12,"[193]NZAHL DER BISHER ERFA\TEN [207]RTE:"+STR$(QQ) 7052 FORI=1TOQQ:INPUT#2,QQ$(I):NEXT 7054 CLOSE2:SV=1:RETURN 7056 : 7060 REM *** TEST AUF AKTUELL ********* 7062 IFSVTHENRETURN 7064 A=PEEK(YA) 7066 SYSPR,0,A+3,"[193]CHTUNG ! [196]IE [201]NDEXDATEI IST NICHT MEHR AKTUELL." 7068 SYSPR,0,A+5,"[211]OLL SIE AKTUALISIERT WERDEN" 7070 GOSUB8030:IFNOTATHENRETURN 7072 : 7080 REM *** AKTUALISIEREN ************ 7082 A=PEEK(YA) 7084 SYSPR,0,A+3,"[196]IE [196]ATEI WIRD NUN AKTUALISIERT, BITTE WARTEN [211]IE. 7086 [158]PR,0,A[170]5,"(STR$ISKETTE IM (null)AUFWERK BELASSEN, SONST STR$ATENVERLUST !!)" 7088 [152]1,"S0:INDEX":[132]1,A 7090 [139]QQ[178]0[167][142] 7092 [159]2,8,2,"INDEX,P,W":[152]2,QQ 7094 [129]I[178]1[164]QQ:[152]2,QQ$(I):[130] 7096 [160]2:[142] 7098 : 7100 [143] *** EINGABEROUTINE *********** 7102 X$[178]"":A[178]0:[158]PR,X,Y,C$([171](W[179]5)) 7104 [151]XL,X:[151]XH,[171](X[177]255):[151]YA,Y 7106 A1[178][194](XL):A2[178][194](XH) 7108 [151]780,219:[158]CH 7110 [151]XL,A1:[151]XH,A2 7112 [161]A$:[139]A$[178]"="[167][139]A[178]0[167][139]W$[179][177]""[167]X$[178]W$:A[178][195](X$):[158]PR,X,Y,X$:[142] 7114 [139]A$[178]C1$[167][139]A[177]0[167][151]780,32:[158]CH:[142] 7116 [139]A$[178]C2$[167][139]A[177]0[167]7102 7118 [139]A$[178][199](34)[176]A[178]W[167]7112 7120 [139]A$[178]"^"[176]A$[178]"\"[167]7124 7122 [139]A$[179]" "[176]A$[177]"Z"[167][139]A$[179]"ATN"[176]A$[177]"(null)"[167]7112 7124 X$[178]X$[170]A$:A[178]A[170]1:[151]780,[198](A$):[158]CH:[137]7106 7126 : 7130 [143] *** ORT HOLEN **************** 7132 [139]QQ[178]0[167]D[178]0:[158]PR,0,7,"(null)EINE (null)RTE ERFA\T.":[137]8000 7134 [158]PR,0,7,"(null)RT:":W$[178]"":W[178]20:X[178]20:Y[178]7:[141]7100:OT$[178]X$ 7136 D[178]0 7138 D[178]D[170]1:[139]D[179][178]QQ[167][139]OT$[179][177]QQ$(D)[167]7138 7140 [139]D[177]QQ[167]D[178]0:[158]PR,0,9,"(null)RT NICHT ERFA\T.":[137]8000 7142 [159]2,8,2,OP$ 7144 [152]1,"P"[170][199](2)[170][199](D)[170]Z$[170]Z$ 7146 [129]I[178]1[164]12 7148 [161]#2,A$,B$,C$:T(I)[178][198](A$[170]Z$)[171]50 7150 N(I)[178][198](B$[170]Z$)[170]256[172][198](C$[170]Z$) 7152 [130]:[160]2:[142] 7154 : 8000 [143] *** "RETURN" ***************** 8002 [158]PR,0,[194](YA)[170]2,"STR$R^CKEN (null)IE [(null)VAL(null)(null)(null)(null)]." 8004 [161]A$:[139]A$[179][177][199](13)[167]8004 8006 [142] 8008 : 8010 [143] *** FEHLERKANAL LESEN ******** 8012 [132]1,A,A$,A1,A2 8014 [139]A[178]0[176]A[178]50[167][142] 8016 B[178][194](YA) 8018 [158]PR,0,B[170]3,"STR$ISK-VALRROR #"[170][202]([196](A),2)[170]": "[170]A$ 8020 A[178]B[170]5:[137]8000 8022 : 8030 [143] *** "JA/NEIN" **************** 8032 [158]PR,[194](XL)[170]256[172][194](XH),[194](YA)," (MID$/(null)) ?" 8034 [161]A$:[139]A$[179][177]"J"[175]A$[179][177]"N"[167]8034 8036 [151]780,[198](A$)[170]32:[158]CH 8038 A[178](A$[178]"J"):[142] 8040 : 8050 [143] *** WAHL ********************* 8052 [158]PR,115,A,"RIGHT$HRE (null)AHL (1-"[170]W$[170]"):" 8054 [161]A$:[139]A$[179]"1"[176]A$[177]W$[167]8054 8056 [151]780,[198](A$):[158]CH 8058 A[178][197](A$) :[142] 8060 : 8070 [143] *** "SICHER ?" *************** 8072 [158]PR,98,A,"(null)IND (null)IE SICHER" 8074 [137]8030 8076 : 8080 [143] *** HARDCOPY ***************** 8082 [158]PR,0,[194](YA)[170]2,"LEFT$ARDCOPY ERSTELLEN" 8084 [141]8030:[139][168]A[167][142] 8086 [158]PR,0,[194](YA),C$(0) 8088 [143] *********************** 8090 [143] * GGF. HARDCOPYAUFRUF * 8092 [143] * ABAENDERN. VGL.TEXT * 8094 [143] *********************** 8096 [158]36864:[142] 8098 : 9000 [143] *** DATEN ******************** 9002 [131] "MID$ANUAR","ASCEBRUAR","(null)@RZ","ATNPRIL","(null)AI","MID$UNI","MID$ULI","ATNUGUST" 9004 [131] "(null)EPTEMBER","(null)KTOBER","(null)OVEMBER","STR$EZEMBER" 9006 :